(*
 * This file is part of MONPOLY.
 *
 * Copyright (C) 2012 ETH Zurich.
 * Contact:  ETH Zurich (Eugen Zalinescu: eugen.zalinescu@inf.ethz.ch)
 * 
 * 
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation, version 2.1 of the
 * License.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library. If not, see
 * http://www.gnu.org/licenses/lgpl-2.1.html.
 *
 * As a special exception to the GNU Lesser General Public License,
 * you may link, statically or dynamically, a "work that uses the
 * Library" with a publicly distributed version of the Library to
 * produce an executable file containing portions of the Library, and
 * distribute that executable file under terms of your choice, without
 * any of the additional requirements listed in clause 6 of the GNU
 * Lesser General Public License. By "a publicly distributed version
 * of the Library", we mean either the unmodified Library as
 * distributed by Nokia, or a modified version of the Library that is
 * distributed under the conditions defined in clause 3 of the GNU
 * Lesser General Public License. This exception does not however
 * invalidate any other reasons why the executable file might be
 * covered by the GNU Lesser General Public License.
 *)

(* This file is a modification of queue.mli from OCaml's standard
 * library, which had the following copyright:
 *)
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the GNU Library General Public License, with    *)
(*  the special exception on linking described in file ../LICENSE.     *)
(*                                                                     *)
(***********************************************************************)

exception Empty

(* O'Caml currently does not allow the components of a sum type to be
   mutable. Yet, for optimal space efficiency, we must have cons cells
   whose [next] field is mutable. This leads us to define a type of
   cyclic lists, so as to eliminate the [Nil] case and the sum
   type. *)

type 'a cell = {
    mutable content: 'a;
    mutable next: 'a cell
  } 

(* A queue is a reference to either nothing or some cell of a cyclic
   list. By convention, that cell is to be viewed as the last cell in
   the queue. The first cell in the queue is then found in constant
   time: it is the next cell in the cyclic list. The queue's length is
   also recorded, so as to make [length] a constant-time operation.

   The [tail] field should really be of type ['a cell option], but
   then it would be [None] when [length] is 0 and [Some] otherwise,
   leading to redundant memory allocation and accesses. We avoid this
   overhead by filling [tail] with a dummy value when [length] is 0.
   Of course, this requires bending the type system's arm slightly,
   because it does not have dependent sums. *)

type 'a t = {
    mutable length: int;
    mutable tail: 'a cell
  } 

let create () = {
  length = 0;
  tail = Obj.magic None
} 

let clear q =
  q.length <- 0;
  q.tail <- Obj.magic None

let add x q =
  q.length <- q.length + 1;
  if q.length = 1 then
    let rec cell = {
      content = x;
      next = cell
    } in
    q.tail <- cell
  else
    let tail = q.tail in
    let head = tail.next in
    let cell = {
      content = x;
      next = head
    } in
    tail.next <- cell;
    q.tail <- cell

let push =
  add

let get_last q = 
  if q.length = 0 then
    raise Empty
  else
    q.tail.content

let update_last x q = 
  if q.length = 0 then
    raise Empty
  else
    q.tail.content <- x

let peek q =
  if q.length = 0 then
    raise Empty
  else
    q.tail.next.content

let top =
  peek

let take q =
  if q.length = 0 then
    raise Empty
  else
    q.length <- q.length - 1;
    let tail = q.tail in
    let head = tail.next in
    if head == tail then
      q.tail <- Obj.magic None
    else
      tail.next <- head.next;
    head.content

let pop =
  take

let copy q =
  if q.length = 0 then
    create()
  else
    let tail = q.tail in

    let rec tail' = {
      content = tail.content;
      next = tail'
    } in

    let rec copy cell =
      if cell == tail then tail'
      else {
        content = cell.content;
        next = copy cell.next
      } in

    tail'.next <- copy tail.next;
    {
      length = q.length;
      tail = tail'
    } 

let is_empty q =
  q.length = 0

let length q =
  q.length

let iter f q =
  if q.length > 0 then
    let tail = q.tail in
    let rec iter cell =
      f cell.content;
      if cell != tail then
        iter cell.next in
    iter tail.next

let iter_while f cond q =
  if q.length > 0 then
    let tail = q.tail in
    let rec iter cell =
      if cond cell.content then
	begin
	  f cell.content;
	  if cell != tail then
            iter cell.next 
	end
    in
    iter tail.next

let update f q =
  if q.length > 0 then
    let tail = q.tail in
    let rec iter cell =
      cell.content <- f cell.content;
      if cell != tail then
        iter cell.next in
    iter tail.next


let update_and_delete f del_cond q =
  if q.length > 0 then
    let tail = q.tail in
    let prev = ref tail in
    let rec iter cell =
      let new_content = f cell.content in
	if del_cond new_content then
	  begin
	    q.length <- q.length - 1;
	    if q.length = 0 then
	      q.tail <- Obj.magic None
	    else
	      begin
		!prev.next <- cell.next;
		if cell == tail then
		  q.tail <- !prev
	      end
	  end
	else
	  begin
	    cell.content <- new_content;
	    prev := cell
	  end;
	if cell != tail then
          iter cell.next 
    in
      iter tail.next


let fold f accu q =
  if q.length = 0 then
    accu
  else
    let tail = q.tail in
    let rec fold accu cell =
      let accu = f accu cell.content in
      if cell == tail then
        accu
      else
        fold accu cell.next in
    fold accu tail.next

let transfer q1 q2 =
  let length1 = q1.length in
  if length1 > 0 then
    let tail1 = q1.tail in
    clear q1;
    if q2.length > 0 then begin
      let tail2 = q2.tail in
      let head1 = tail1.next in
      let head2 = tail2.next in
      tail1.next <- head2;
      tail2.next <- head1
    end;
    q2.length <- q2.length + length1;
    q2.tail <- tail1

